Signed Curvature of a Plane Curve

The general  notion of curvature of a curve in (ℝ^n) does not take account of sign. For curves in (ℝ^2) there is a more refined notion of signd  that does.

(Subscript[κ, S])[α_][t_]:=((α''[t] .RotationTransform[(π/2)][α'[t]])/(((α'[t].α'[t]))^(3/2)))

α must be a 2D vector valued function and t must be a real number.

RotationTransform is one of Mathematica’s geometric functions, which rotates a vector through a given angle:

a[t_]:={x[t],y[t]}

(Subscript[κ, S])[a][t]

The above definition works for functions ℝ->(ℝ^2). We give another one for a pair of functions:

(Subscript[κ, S])[{x_,y_}][t_]=((-y'[t] x''[t]+x'[t] y''[t])/(((((x'[t])^2)+((y'[t])^2)))^(3/2)));

and one more for a pair of expressions.

(Subscript[κ, S])[{x_,y_},t_]:=(Subscript[κ, S])[{Function[x/.t->#],Function[y/.t->#]}][t]

Here we calculate signed curvature of a circle given as a pair of expressions.

(Subscript[κ, S])[{Sin[t],Cos[t]},t]//Simplify

Here is the same thing for a pair of functions:

(Subscript[κ, S])[{Cos ,Sin}][t]//Simplify

(Subscript[κ, S])[{Cos,Sin}][t]//Simplify

and here for a single function with values in (ℝ^2)

(Subscript[κ, S])[{Cos[#],Sin[#]}&][t]//Simplify

bulletnose[a_,b_][t_]:={a Cos[t],b Cot[t]}

(Subscript[κ, S])[bulletnose[a,b]][(π/3)]

The positive function (1/(Abs[(Subscript[κ, s])(α)])) is called the radius of curvature of α.

Evolutes

Circles of curvature

A point p∈(ℝ^2) is called the center of curvature at q of a curve α:(a,b)->(ℝ^2) provided there is a circle γ with centre p which is tangent to α at q and such that the curvature of α and γ are the same at q. Since the radius of curvature of a circle is equal to its radius, the radius of the circle of curvature is the radius of curvature.

The centers of the circles of curvature of a curve α form a curve called the evolute of α. The equation of the evolute is:

evolute[f_][t_]:=Simplify[((RotationTransform[(π/2)][f'(t)])/((Sqrt[f'(t).f'(t)]) (Subscript[κ, S])(f)(t)))+f(t)]

gg[t_]:={x[t],y[t]}

evolute[gg][t]

evolute[{x_,y_}][t_]=evolute[gg][t]

As earlier, we define the evolute for curves given by pairs of functions and pairs of expressions.

evolute[{x_,y_},t_]:=evolute[{Function[x/.t->#],Function[y/.t->#]}][t]

evolute[{a Sin[#]&,b Cos[#]&}][t]//Simplify

evolute[{a Sin[#],b Cos[#]}&][t]

gr=ParametricPlot[{{2Cos[t],3Sin[t]},evolute[{2 Cos[#]&,3Sin[#]&}][t]},{t,0,2Pi}]

Manipulate[Show[gr,Graphics[{Red,PointSize[0.02],Point[evolute[{2 Cos[#]&,3Sin[#]&}][t]],Circle[evolute[{2 Cos[#]&,3Sin[#]&}][t],1/Abs[(Subscript[κ, S])[{2 Cos[#]&,3Sin[#]&}][t]]]}],PlotRange->8],{t,0,2Pi},SaveDefinitions->True]

Involutes

The involute is the operation of taking the inverse to the operation that assigns to a curve its evolute. The relation between evolute and involute is analogous to the relation between differentiation and integration. The deinition of involute uses integration but this very rarely can be successfully done symbolically. Therefore we will  mostly usea numerical definition which is suitable for finding involutes graphically. To define an involute, we need to give not only a curve but also a starting value c of the parameter.

nInvolute[α_,c_][t_]:=-(α'[t] NIntegrate[Norm[α'[s]],{s,c,t}])/Norm[α'[t]]+α[t]

nInvolute[{Cos[#],Sin[#]}&,0][0.3]

Making the graphic of an involute even of a cirlce takes a long time.

ParametricPlot[nInvolute[{Cos[#],Sin[#]}&,0][t],{t,0,8Pi}]

We also give a symbolic definition of involute. In those cases when involutes can be found explicitely, drawing them becomes much quicker.

involute(α_,c_)(t_):=Assuming[t∈ℝ,Simplify[((-α'(t)Integrate[(Sqrt[α'(s).α'(s)]),{s,c,t},Assumptions->{t>=c>=0}])/(Sqrt[α'(t).α'(t)]))+α(t)]]

involute[{x_,y_},c_,t_]:=involute[Function[{x,y}/.t->#],c][t]

inv[t_]=involute[{2 Cos[#],3Sin[#]}&,0][t]

ParametricPlot[inv[t],{t,0,8Pi}]

ParametricPlot[Evaluate[involute[{Cos[#],Sin[#]}&,0][t]],{t,0,8Pi}]

g=ParametricPlot[Evaluate[involute[{2Cos[#],3Sin[#]}&,0][t]],{t,0,8Pi}]

ParametricPlot[Evaluate[{{2Cos[t],3Sin[t]},involute[{2Cos[#],3Sin[#]}&,0][t]}],{t,0,4Pi}]

h=involute[a{ Cos[t],Sin[t]},b,t]//Factor

g=evolute[h,t]//FullSimplify

FullSimplify[involute[g,0,t],Assumptions->t>0]